home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fballs.F < prev    next >
Text File  |  1991-06-03  |  3KB  |  155 lines
  1. c
  2. c makesphere
  3. c
  4. c    make a sphere object
  5. c
  6.     subroutine makesp
  7.  
  8.     integer SPHERE
  9.     real r, z, a, RADIUS, PI
  10.     parameter (PI = 3.1415926535, RADIUS = 10.0, SPHERE = 1)
  11.  
  12.     call makeob(SPHERE)
  13.  
  14. c
  15. c create the latitudinal rings
  16. c
  17.         do 10 i = 0, 1800, 200
  18.         call pushma
  19.             call rotate(i, 'y')
  20.             call circ(0.0, 0.0, RADIUS)
  21.         call popmat
  22. 10        continue
  23.         
  24. c
  25. c create the longitudinal rings
  26. c
  27.         call pushma
  28.         call rotate(900, 'x')
  29.         do 20 a = -900, 900, 200
  30.             r = RADIUS * cos(a * PI / 180.0)
  31.             z = RADIUS * sin(a * PI / 180.0)
  32.             call pushma
  33.             call transl(0.0, 0.0, -z)
  34.             call circ(0.0, 0.0, r)
  35.             call popmat
  36. 20        continue
  37.         call popmat
  38.  
  39.     call closeo
  40.  
  41.     end
  42.  
  43. c
  44. c a demonstration of objects
  45. c
  46.     program fballs
  47.  
  48. #ifdef SGI
  49. #include "fgl.h"
  50. #include "fdevice.h"
  51. #else
  52. #include "fvogl.h"
  53. #include "fvodevice.h"
  54. #endif
  55.  
  56.     integer *2 val
  57.     integer SPHERE
  58.     real RADIUS
  59.     parameter (RADIUS = 10.0)
  60.     parameter(SPHERE = 1)
  61.  
  62.     call winope('fballs', 6)
  63.     call unqdev(INPUTC)
  64.     call qdevic(KEYBD)
  65.  
  66.  
  67. c
  68. c set up our viewing transformation
  69. c
  70.     call perspe(900, 1.0, 0.001, 500.0)
  71.     call lookat(13.0, 13.0, 8.0, 0.0, 0.0, 0.0, 0)
  72.  
  73.     call color(BLACK)
  74.     call clear
  75.  
  76. c
  77. c Call a routine to make the sphere object
  78. c
  79.     call makesp
  80.  
  81. c
  82. c Now draw the sphere object scaled down. We use the pushmatrix
  83. c and the popmatrix to preserve the transformation matrix so
  84. c that only this sphere is drawn scaled. The callobj then enables
  85. c us to draw the sphere we generated with makeobj in makesphere.
  86. c
  87.     call color(CYAN)
  88.  
  89.     call pushma
  90.         call scale(0.5, 0.5, 0.5)
  91.         call callob(SPHERE)
  92.     call popmat
  93.  
  94. c
  95. c now we draw the same sphere translated, with a different
  96. c scale and color.
  97. c
  98.     call color(WHITE)
  99.  
  100.     call pushma
  101.         call transl(0.0, -1.4 * RADIUS, 1.4 * RADIUS)
  102.         call scale(0.3, 0.3, 0.3)
  103.         call callob(SPHERE)
  104.     call popmat
  105.  
  106. c
  107. c and maybe a few more times....
  108. c
  109.  
  110.     call color(RED)
  111.  
  112.     call pushma
  113.         call transl(0.0, RADIUS, 0.7 * RADIUS)
  114.         call scale(0.2, 0.2, 0.2)
  115.         call callob(SPHERE)
  116.     call popmat
  117.  
  118.     call color(GREEN)
  119.  
  120.     call pushma
  121.         call transl(0.0, 1.5 * RADIUS, -RADIUS)
  122.         call scale(0.15, 0.15, 0.15)
  123.         call callob(SPHERE)
  124.     call popmat
  125.  
  126.     call color(YELLOW)
  127.  
  128.     call pushma
  129.         call transl(0.0, -RADIUS, -RADIUS)
  130.         call scale(0.12, 0.12, 0.12)
  131.         call callob(SPHERE)
  132.     call popmat
  133.  
  134.     call color(BLUE)
  135.  
  136.     call pushma
  137.         call transl(0.0, -2.0*RADIUS, -RADIUS)
  138.         call scale(0.3, 0.3, 0.3)
  139.         call callob(SPHERE)
  140.     call popmat
  141.  
  142.     call hfont('times.rb', 8)
  143.     call ortho2(0.0, 1.0, 0.0, 1.0)
  144.     call hcente(.true.)
  145.     call htexts(0.08, 0.15)
  146.     call move2(0.8, 0.5)
  147.     call htexta(-90.0)
  148.     call hchars('I''m very ordinary!', 18)
  149.  
  150.     idum = qread(val)
  151.  
  152.     call gexit
  153.  
  154.     end
  155.